perm filename XAP3[XAP,BGB] blob
sn#052882 filedate 1973-07-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001 VALID 00004 PAGES
C00002 00002 SUBR(GETFIL) GET FILE SPECIFICATION.
C00004 00003 SUBR(GETCHR) GET A CHARACTER FROM THE TEXT BUFFER.
C00006 00004 SUBR(INFILE) INDIRECT FILE COMMAND "@".
C00009 ENDMK
C⊗;
SUBR(GETFIL) ;GET FILE SPECIFICATION.
BEGIN GETFIL;_____________________________________________________
;CLEAR FILENAME SPECIFICATION.
DZM FILNAM
DZM EXTION
DZM EXTION+1
DZM PPPN
;AC1-CHR, AC2-CNT, AC3, AC4-BP.
LAC 4,[POINT 6,FILNAM,-1]↔LACI 2,6
CALL(GETCHR)
CAIN 1,15↔GO[CALL(GETCHR)↔POP0J]
SKIPA
L: CALL(GETCHR)
CAILE 1,"z"↔POP0J
CAIL 1,"a"↔SUBI 1,40 ;CONVERT LOWER CASE
CAIN 1,"."↔GO[LAC 4,[POINT 6,EXTION,-1]↔LACI 2,3↔GO L]
CAIN 1,"["↔GO[LAC 4,[POINT 6,PPPN,-1] ↔LACI 2,3↔GO L]
CAIN 1,","↔GO[LAC 4,[POINT 6,PPPN,17] ↔LACI 2,3↔GO L]
CAIN 1,"]"↔CALL(GETCHR)
CAIN 1,";"↔GO EOL ;XAP COMMAND POSTFIX.
CAIG 1," "↔GO EOL
SOJL 2,L↔SUBI 1,40 ;COUNT'EM AND CONVERT TO SIXBIT.
IDPB 1,4↔GO L ;PACK CHARACTER INTO SPECIFICATIONS.
EOL:
CAR PPPN↔TRNN 77↔LSH -6↔TRNN 77↔LSH -6↔DIP PPPN
CDR PPPN↔TRNN 77↔LSH -6↔TRNN 77↔LSH -6↔DAP PPPN
POP0J
BEND GETFIL;BB 30 MAY 1973.___________________________________________
SUBR(GETCHR) GET A CHARACTER FROM THE TEXT BUFFER.
BEGIN GETCHR;_____________________________________________________
SOSGE CHRCNT↔GO .+3
ILDB 1,TXTPTR↔POP0J
SETOM EOF↔SETZ 1,
POP0J
BEND GETCHR;BGB 30 MAY 1973._____________________________________
SUBR(GETNUM) GET AN INTEGER.
BEGIN GETNUM;________________________________________________________
SETZM↔CALL(GETCHR)
CAIL 1,"0"↔CAILE 1,"9"↔GO[
EXCH 1,0↔POP0J]↔ANDI 1,17
IMULI 0,=10↔ADD 0,1
GO GETNUM+1
BEND GETNUM;_________________________________________________________
SUBR(GET14) GET A 14 BIT NUMBER
BEGIN GET14
CALL(GETCHR)↔LSH 1,7↔PUSH P,1
CALL(GETCHR)↔ADD 1,(P)↔POP P,(P)
POP0J
BEND GET14;__________________________________________________________
SUBR(INFILE) INDIRECT FILE COMMAND "@".
BEGIN INFILE;_____________________________________________________
;FILE INITIALIZATION.
PUSH P,TXTPTR ;SAVE TEXT POINTER.
INIT 1,17↔SIXBIT/DSK/↔0
GO[FATAL(CAN'T INIT DSK)]
CALL(GETFIL)
LOOKUP 1,FILNAM↔GO L1
;WIPE OUT INDIRECT COMMAND.
POP P,1↔ADD 1,[7B5] ;DECREMENT OLDE TEXT POINTER.
LACI"F"↔IDPB 0,1
LACI"."↔IDPB 0,1
DAPZ 1,PTR1#
SETZ↔IDPB 0,1
CAME 1,TXTPTR↔GO .-2
DAPZ 1,PTR2#
;EXPAND CORE WHEN NECESSARY.
NIP PPPN↔MOVMS↔DAC SIZE# ;WORD COUNT.
IMULI =5↔ADDM CHRCNT ;NEW CHARACTER COUNT.
LAC 1,TXTEND↔ADD 1,SIZE↔DAC 1,NEWEND# ;NEW TOP OF CORE.
CDR 1,NEWEND↔CAMG 1,JOBREL↔GO .+3
CORE 1,↔GO[FATAL(<NO ROOM FOR TEXT.>)]
;MOVE TOP OF TEXT BUFFER UP CORE.
SETO 1,↔LAP 1,TXTEND
LAC SIZE↔DAP .+3
CDR TXTEND↔SUB PTR2
POP 1,SIZE(1)↔SOJG .-1
;STEP ON A FUNNY CASE.
LAC 1,PTR1↔LAC 2,PTR2↔CAME 1,2↔GO L2
ADD 2,SIZE↔LIPI 1,440700↔LIPI 2,440700
SETZ 3,↔LACI 4,5
ILDB 0,1↔IDPB 3,2 ;CLEAR LEADING BYTES OF TWO.
SOJLE 4,L2↔JUMPN 0,.-3
IDPB 3,2↔SOJG 4,.-1 ;CLEAR LAGGING BYTES OF ONE.
L2:
;INPUT THE FILE.
LAC NEWEND↔DAC TXTEND
; LAC PPPN↔LAP PTR1↔DAC DUMARG
LAC PTR1↔LIPI 000700↔DAC TXTPTR↔HLL PPPN↔DAC DUMARG
IN 1,DUMARG↔GO[ RELEASE 1,
SETZM CMODE ;ENTER TEXT MODE.
POP0J ]
FATAL(READ ERROR!)
DUMARG:0↔0
L1: OUTSTR[ASCIZ/FILE NOT FOUND - /]
POP P,1↔LAC 2,[POINT 7,4]↔LACI 3,=25
ILDB 1↔CAIN";"↔GO .+3↔IDPB 2↔SOJG 3,.-4
SETZ↔IDPB 2↔OUTSTR 4↔CRLF↔EXIT
BEND INFILE;BGB 30 MAY 1973.--------------------------------------